home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / matenc.arc / CPP1570.CLP next >
Text File  |  1991-12-04  |  5KB  |  105 lines
  1.  CPP1570:    PGM        PARM(&PGM &FILE &MBR &CRTFILE &ADDMBR &MBROPT)
  2.  
  3.              /*         Program - CPP1570  */
  4.              /*         CPP for command - MATPGM  */
  5.              /*         Materialize a program into a data base file. */
  6.  
  7.              DCL        &PGM  *CHAR 20   /* Program.Library name */
  8.              DCL        &FILE *CHAR 20   /* File.Library name */
  9.              DCL        &MBR  *CHAR 10   /* Member name */
  10.              DCL        &CRTFILE *CHAR 4 /* Create file option */
  11.              DCL        &ADDMBR  *CHAR 4 /* Add Mbr if non-existant */
  12.              DCL        &MBROPT  *CHAR 8 /* Replace, add member data */
  13.  
  14.              DCL        &P    *CHAR 10 /* Program name */
  15.              DCL        &PL   *CHAR 10 /* Program's library name */
  16.              DCL        &F    *CHAR 10 /* File name */
  17.              DCL        &FL   *CHAR 10 /* File's library name */
  18.  
  19.              DCL        &CNT    *DEC  003
  20.              DCL        &MSGID  *CHAR 007
  21.              DCL        &MSGDTA *CHAR 132
  22.              MONMSG     MSGID(CPF0000) EXEC(GOTO RCVMSG)
  23.  
  24.              CHGVAR     VAR(&F) VALUE(%SST(&FILE 01 10))
  25.              CHGVAR     VAR(&FL) VALUE(%SST(&FILE 11 10))
  26.              CHGVAR     VAR(&P) VALUE(%SST(&PGM 01 10))
  27.              CHGVAR     VAR(&PL) VALUE(%SST(&PGM 11 10))
  28.              IF         (&MBR *EQ '*PGM') CHGVAR VAR(&MBR) +
  29.                           VALUE(%SST(&PGM 01 10))
  30.  
  31.  CHKPGM:     CHKOBJ     OBJ(%SST(&PGM 01 10).%SST(&PGM 11 10)) +
  32.                           OBJTYPE(*PGM) AUT(*OPER *READ)
  33.  
  34.  CHKFILE:    CHKOBJ     OBJ(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  35.                           OBJTYPE(*FILE) MBR(&MBR) AUT(*NORMAL)
  36.              MONMSG     MSGID(CPF9801) EXEC(DO)
  37.  CRTFILE:    IF         (&CRTFILE *EQ '*YES') +
  38.              DO
  39.                IF         (%SST(&FILE 11 10) *EQ '*LIBL')  +
  40.                           CRTPF FILE(%SST(&FILE 01 10)) RCDLEN(80) +
  41.                           MBR(&MBR) MAXMBRS(32767) SIZE(6400 6400 8) +
  42.                           LVLCHK(*NO) TEXT('Program template for +
  43.                           program' *BCAT &PGM)
  44.  
  45.              ELSE       CRTPF FILE(%SST(&FILE 01 10).%SST(&FILE 11 +
  46.                           10)) RCDLEN(80) MBR(&MBR) MAXMBRS(32767) +
  47.                           SIZE(6400 6400 8) LVLCHK(*NO) TEXT('Program +
  48.                           template for program' *BCAT &PGM)
  49.  
  50.              RCVMSG
  51.              RCVMSG
  52.              GOTO       MATPGM
  53.              ENDDO
  54.  
  55.              SNDPGMMSG  MSG('File' *BCAT %SST(&FILE 01 10) *TCAT '.' +
  56.                           *TCAT %SST(&FILE 11 10) *BCAT 'not found.') +
  57.                           TOPGMQ(*PRV) MSGTYPE(*DIAG)
  58.              RETURN
  59.              ENDDO
  60.  NOMBR:      MONMSG     MSGID(CPF9815) EXEC(DO)
  61.  
  62.              CHKOBJ     OBJ(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  63.                           OBJTYPE(*FILE) AUT(*OPER *OBJMGT *READ *ADD +
  64.                           *UPD *DLT)
  65.  
  66.              IF         (&ADDMBR *EQ '*YES') DO
  67.              ADDPFM     FILE(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  68.                           MBR(&MBR) TEXT('Program Template for +
  69.                           program ' *CAT &PGM)
  70.  
  71.              GOTO       MATPGM
  72.              ENDDO
  73.  
  74.              SNDPGMMSG  MSG('Member ' *CAT &MBR *BCAT 'does not exist +
  75.                           in file' *BCAT %SST(&FILE 01 10) *TCAT '.' +
  76.                           *CAT %SST(&FILE 11 10)) MSGTYPE(*DIAG)
  77.              RETURN
  78.              ENDDO
  79.  
  80.  CHKCRT:     IF         (&CRTFILE *EQ '*YES') DO
  81.                SNDPGMMSG  MSG('File' *BCAT %SST(&FILE 01 10) *TCAT  +
  82.                             '.' *CAT %SST(&FILE 11 10) *BCAT +
  83.                             'already exists.') MSGTYPE(*DIAG)
  84.                RETURN
  85.              ENDDO
  86.  
  87.              /*         Materialize program template.  */
  88.  MATPGM:     CALL       PGM(QSCMATPG) PARM(&P &PL &F &FL &MBR &MBROPT)
  89.  
  90.  RCVMSG:     /*         Receive and forward program messages. */
  91.              RCVMSG     RMV(*YES) MSGDTA(&MSGDTA) MSGID(&MSGID)
  92.              IF         (&MSGID *EQ ' ')  RETURN
  93.              IF         (%SST(&MSGID 1 2) *EQ 'CP'  +
  94.                      *OR %SST(&MSGID 1 3) *EQ 'MCH')  DO
  95.              IF         (&MSGDTA *EQ ' ') SNDPGMMSG  MSGID(&MSGID) +
  96.                           MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  97.              ELSE       SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) +
  98.                           MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  99.              CHGVAR     VAR(&CNT) VALUE(&CNT + 1)
  100.              IF         ((&CNT *GT 0) *AND (&CNT *LT 10)) GOTO RCVMSG
  101.                           /* MAXMSG(10) */
  102.              ENDDO
  103.  
  104.  ENDPGM:     ENDPGM
  105.